perm filename MILISY.FST[1,VDS] blob
sn#029613 filedate 1973-03-19 generic text, type T, neo UTF8
(LAP TFX SUBR)
(JSP 6 SPECBIND)
(0 0 (SPECIAL V))
(PUSH P 1)
(MOVEI 2 (QUOTE TF))
(PUSH P 1)
(MOVE 1 -1 P)
(CALL 2 (E GET))
(HLRZ@ 3 (SPECIAL SUBTREE))
(HLRZ@ 2 1)
(MOVEM 1 -1 P)
(MOVEI 1 (QUOTE NIL))
(CALL 3 (E MATCH))
(MOVEM 1 (SPECIAL V))
(PUSH P (C 0 0 (QUOTE NIL) 0))
(JUMPE 1 TAG3)
(HRRZ@ 1 -2 P)
(HRRZ@ 1 1)
(JUMPE 1 TAG1)
(HRRZ@ 2 -2 P)
(HRRZ@ 2 2)
(HLRZ@ 2 2)
(MOVE 1 (SPECIAL V))
(CALL 2 (E SUBSTITUTE))
(MOVEM 1 0 P)
(CALL 1 (E *EVAL))
(JUMPE 1 TAG3)
TAG1 (HRRZ@ 2 -2 P)
(HLRZ@ 2 2)
(MOVE 1 (SPECIAL V))
(CALL 2 (E SUBSTITUTE))
(MOVEM 1 0 P)
(HRLM@ 1 (SPECIAL SUBTREE))
(MOVE 1 (SPECIAL TREE-TRACE))
(JUMPE 1 TAG10)
(MOVE 1 -1 P)
(CALL 1 (E NCONS))
(MOVEI 2 (QUOTE APPLY))
(CALL 2 (E XCONS))
(CALL 1 (E PRINT))
(MOVE 1 (SPECIAL TREE))
(CALL 1 (E PRINTREE))
(JRST 0 TAG7)
TAG10 (MOVE 1 (SPECIAL TF-TRACE))
(JUMPE 1 TAG11)
(MOVE 1 -1 P)
(CALL 1 (E PRINT))
TAG11
TAG7 (MOVEI 1 (QUOTE T))
(JRST 0 TAG2)
TAG3 (MOVEI 1 (QUOTE NIL))
TAG2 (SUB P (C 0 0 3 3))
(JRST 0 SPECSTR)
NIL (LAP SUBSTITUTE SUBR)
(JSP 6 SPECBIND)
(0 1 (SPECIAL V))
(0 0 (SPECIAL Y))
(PUSH P 2)
(MOVE 1 2)
(SUB P (C 0 0 1 1))
(CALL 1 (E SUBS))
(JRST 0 SPECSTR)
NIL
(LAP SUBS SUBR)
(PUSH P 1)
(CALL 1 (E NUMBERP))
(JUMPE 1 TAG2)
(MOVE 2 (SPECIAL V))
(MOVE 1 0 P)
(CALL 2 (E ASSOC))
(MOVEM 1 (SPECIAL Y))
(JUMPE 1 TAG4)
(HRRZ@ 1 1)
(JRST 0 TAG3)
TAG4 (MOVE 1 0 P)
TAG5
TAG3 (JRST 0 TAG1)
TAG2 (MOVE 1 0 P)
(CALL 1 (E ATOM))
(JUMPE 1 TAG7)
(MOVE 1 0 P)
(JRST 0 TAG1)
TAG7 (HLRZ@ 1 0 P)
(CALL 1 (E SUBS))
(PUSH P 1)
(HRRZ@ 1 -1 P)
(CALL 1 (E SUBS))
(POP P 2)
(CALL 2 (E XCONS))
TAG10
TAG1 (SUB P (C 0 0 1 1))
(POPJ P)
NIL (LAP MATCH SUBR)
(JSP 6 SPECBIND)
(0 1 (SPECIAL V))
(0 0 (SPECIAL X))
(PUSH P 2)
(PUSH P 3)
(MOVE 2 3)
(MOVE 1 -1 P)
(CALL 2 (E MACH))
(JUMPE 1 TAG4)
(MOVE 1 (SPECIAL V))
(JUMPE 1 TAG5)
(JRST 0 TAG4)
TAG5 (MOVEI 1 (QUOTE T))
TAG6
TAG4 (SUB P (C 0 0 2 2))
(JRST 0 SPECSTR)
NIL
(LAP MACH SUBR)
(PUSH P 1)
(PUSH P 2)
(CAME 1 2)
(JRST 0 TAG2)
(MOVEI 1 (QUOTE T))
(JRST 0 TAG1)
TAG2 (CALL 1 (E NUMBERP))
(JUMPE 1 TAG3)
(MOVE 1 -1 P)
(CAIE 1 (QUOTE 0))
(JRST 0 TAG5)
(MOVEI 1 (QUOTE T))
(JRST 0 TAG4)
TAG5 (MOVE 2 (SPECIAL V))
(CALL 2 (E ASSOC))
(MOVEM 1 (SPECIAL X))
(JUMPE 1 TAG6)
(MOVE 2 0 P)
(HRRZ@ 1 1)
(CALL 2 (E EQUAL))
(JRST 0 TAG4)
TAG6 (MOVE 2 0 P)
(MOVE 1 -1 P)
(CALL 2 (E CONS))
(MOVE 2 (SPECIAL V))
(CALL 2 (E CONS))
(MOVEM 1 (SPECIAL V))
(MOVEI 1 (QUOTE T))
TAG7
TAG4 (JRST 0 TAG1)
TAG3 (MOVE 1 -1 P)
(CALL 1 (E ATOM))
(JUMPE 1 TAG11)
(MOVEI 1 (QUOTE NIL))
(JRST 0 TAG1)
TAG11 (MOVE 1 0 P)
(CALL 1 (E ATOM))
(JUMPE 1 TAG12)
(MOVEI 1 (QUOTE NIL))
(JRST 0 TAG1)
TAG12 (HLRZ@ 2 0 P)
(HLRZ@ 1 -1 P)
(CALL 2 (E MACH))
(JUMPE 1 TAG16)
(HRRZ@ 2 0 P)
(HRRZ@ 1 -1 P)
(CALL 2 (E MACH))
(JUMPN 1 TAG15)
TAG16 (TDZA 1 1)
TAG15 (MOVEI 1 (QUOTE T))
TAG13
TAG1 (SUB P (C 0 0 2 2))
(POPJ P)
NIL (LAP PARSE SUBR)
(PUSH P 1)
(PUSH P 2)
(PUSH P 3)
(PUSH P (C 0 0 (QUOTE NIL) 0))
(PUSH P (C 0 0 (QUOTE NIL) 0))
(MOVEI 2 (QUOTE PRULE))
(MOVE 1 -3 P)
(CALL 2 (E GET))
(MOVEM 1 0 P)
(JUMPE 1 TAG5)
(MOVE 1 -3 P)
(CALL 1 (E NCONS))
(CALL 1 (E NCONS))
(PUSH P 1)
(HLRZ@ 1 3)
(HRRZ@ 1 1)
(POP P 2)
(HRRM@ 2 1)
(HLRZ@ 2 3)
(HRRZ@ 2 2)
(HRRZ@ 2 2)
(HLRZ@ 1 3)
(HLRZ@ 1 1)
(CALL 2 (E CONS))
(HRRZ@ 2 3)
(CALL 2 (E CONS))
(HLRZ@ 2 3)
(HRRZ@ 2 2)
(HRRZ@ 2 2)
(HLRZ@ 2 2)
(CALL 2 (E XCONS))
(EXCH 3 1)
(HRRZ@ 2 0 P)
(MOVE 1 -4 P)
(CALL 3 (E PAR))
(JRST 0 TAG1)
TAG5 (MOVEI 2 (QUOTE SET))
(MOVE 1 -3 P)
(CALL 2 (E GET))
(MOVEM 1 -1 P)
(JUMPE 1 TAG6)
(EXCH 2 1)
(HLRZ@ 1 -4 P)
(CALL 2 (E MEMQ))
(JUMPE 1 TAG10)
(HLRZ@ 1 -4 P)
(CALL 1 (E NCONS))
(MOVE 2 -3 P)
(CALL 2 (E XCONS))
(CALL 1 (E NCONS))
(PUSH P 1)
(HLRZ@ 1 -3 P)
(HRRZ@ 1 1)
(POP P 2)
(HRRM@ 2 1)
(JRST 0 TAG7)
TAG10 (JRST 0 TAG2)
TAG7 (JRST 0 TAG4)
TAG6 (HLRZ@ 1 -4 P)
(CAME 1 -3 P)
(JRST 0 TAG12)
(MOVE 1 -3 P)
(CALL 1 (E NCONS))
(PUSH P 1)
(HLRZ@ 1 3)
(HRRZ@ 1 1)
(POP P 2)
(HRRM@ 2 1)
(JRST 0 TAG4)
TAG12 (JRST 0 TAG2)
TAG4 (HLRZ@ 2 -2 P)
(HRRZ@ 2 2)
(HRRZ@ 2 2)
(HLRZ@ 1 -2 P)
(HLRZ@ 1 1)
(CALL 2 (E CONS))
(HRRZ@ 2 -2 P)
(CALL 2 (E CONS))
(MOVE 2 1)
(HRRZ@ 1 -4 P)
(CALL 2 (E NEXT))
TAG2 (MOVEI 1 (QUOTE NIL))
TAG1 (SUB P (C 0 0 5 5))
(POPJ P)
NIL
(LAP PAR SUBR)
(PUSH P 1)
(PUSH P 2)
(PUSH P 3)
(JUMPE 2 TAG2)
(TDZA 1 1)
TAG2 (MOVEI 1 (QUOTE T))
(JUMPN 1 TAG1)
(HLRZ@ 1 -1 P)
(JUMPN 1 TAG3)
(CALL 1 (E NCONS))
(PUSH P 1)
(HLRZ@ 1 -1 P)
(POP P 2)
(HRRM@ 2 1)
(HRRZ@ 2 0 P)
(MOVE 1 -2 P)
(CALL 2 (E NEXT))
(JRST 0 TAG1)
TAG3 (HLRZ@ 2 0 P)
(HLRZ@ 1 -1 P)
(HRRZ@ 1 1)
(CALL 2 (E CONS))
(HRRZ@ 2 0 P)
(CALL 2 (E CONS))
(MOVE 3 1)
(HLRZ@ 2 -1 P)
(HLRZ@ 2 2)
(MOVE 1 -2 P)
(CALL 3 (E PARSE))
(MOVE 3 0 P)
(HRRZ@ 2 -1 P)
(MOVE 1 -2 P)
(CALL 3 (E PAR))
TAG4
TAG1 (SUB P (C 0 0 3 3))
(POPJ P)
NIL
(LAP NEXT SUBR)
(PUSH P 1)
(PUSH P 2)
(JUMPN 1 TAG2)
(HRRZ@ 1 2)
(JUMPN 1 TAG2)
(HLRZ@ 3 0 P)
(HRRZ@ 3 3)
(HLRZ@ 3 3)
(MOVEI 2 (QUOTE 0))
(MOVEI 1 (QUOTE 0))
(CALL 3 (E SUBST))
(MOVE 2 (SPECIAL TREE))
(CALL 2 (E CONS))
(MOVEM 1 (SPECIAL TREE))
(JRST 0 TAG1)
TAG2 (HRRZ@ 1 0 P)
(JUMPE 1 TAG4)
(TDZA 1 1)
TAG4 (MOVEI 1 (QUOTE T))
(JUMPN 1 TAG1)
(HLRZ@ 1 0 P)
(HLRZ@ 1 1)
(JUMPN 1 TAG5)
(HRRZ@ 2 0 P)
(MOVE 1 -1 P)
(CALL 2 (E NEXT))
(JRST 0 TAG1)
TAG5 (HLRZ@ 2 0 P)
(HRRZ@ 2 2)
(HLRZ@ 1 0 P)
(CALL 1 (E CDAR))
(CALL 2 (E CONS))
(HRRZ@ 2 0 P)
(CALL 2 (E CONS))
(MOVE 3 1)
(HLRZ@ 2 0 P)
(HLRZ@ 2 2)
(HLRZ@ 2 2)
(MOVE 1 -1 P)
(CALL 3 (E PARSE))
TAG6
TAG1 (SUB P (C 0 0 2 2))
(POPJ P)
NIL (LAP FINDNODE1 SUBR)
(PUSH P 1)
(CALL 1 (E ATOM))
(JUMPE 1 TAG2)
(MOVEI 1 (QUOTE NIL))
(JRST 0 TAG1)
TAG2 (HLRZ@ 1 0 P)
(CALL 1 (E ATOM))
(JUMPE 1 TAG3)
(HRRZ@ 1 0 P)
(CALL 1 (E FINDNODE1))
(JRST 0 TAG1)
TAG3 (HLRZ@ 1 0 P)
(HLRZ@ 1 1)
(CAME 1 (SPECIAL N))
(JRST 0 TAG4)
(MOVE 1 0 P)
(JRST 0 TAG1)
TAG4 (HLRZ@ 1 0 P)
(CALL 1 (E FINDNODE1))
(MOVEM 1 (SPECIAL Y))
(JUMPE 1 TAG5)
(JRST 0 TAG1)
TAG5 (HRRZ@ 1 0 P)
(CALL 1 (E FINDNODE1))
TAG6
TAG1 (SUB P (C 0 0 1 1))
(POPJ P)
NIL 00100 ~ MILISY: THE MINI-LINGUISTIC SYSTEM
00200 ~ WRITTEN JANUARY 1972 BY TOM MORAN,
00300 ~ COMPUTER SCIENCE DEPARTMENT, CARNEGIE-MELLON UNIVERSITY, PITTSBURGH, PENNSYLVANIA
00400 ~ REVISED JULY 1972
00500 ~ DOCUMENTATION ON REVISIONS FOUND ON PRDOC[206,CCG],TRACE.DOC[206,CCG]
00600
00700 ~ ADDITIONAL REVISIONS FEBRUARY 1973 BY ARTHUR FLEXSER
00800 ~ PSYCHOLOGY DEPARTMENT, STANFORD UNIVERSITY
00900 ~ DOCUMENTATION FOUND ON MILDOC[206,AF5]
01000
01100 [PROG ()
01200
01300
01400 [DE CONVERSE () (PROG (F TREE)
01500
01600 (SETQ REPLY @HELLO)
01700 A (PRINT REPLY)
01800 (LISTEN)
01900 (COND ((ATOM STRING) (TERPRI) (RETURN @BYE))
02000 ((EQ (CAR STRING) @HOW) (SINGULARIZE (CDDR STRING))))
02100 (SETQ TREE NIL)
02200 (PARSE STRING @<S> @((NIL NIL)))
02300 (COND ((NULL TREE) (SETQ REPLY @(I CANT PARSE YOUR INPUT)) (GO A)))
02400 (SETQ F FACTS)
02500 (COND (FACT-TRACE (TERPRI)
02600 (PRINC @"THE FACT LIST IS INITIALLY:")
02700 (PRINT FACTS)
02800 (TERPRI)))
02900 (COND ((NULL (INTERPRET-S TREE))
03000 (COND ((AND (NOT (EQ FACTS F)) FACT-TRACE)
03100 (TERPRI)
03200 (PRINC @"RESTORING FACT LIST TO:")
03300 (PRINT F) (SETQ FACTS F) (TERPRI))
03400 (T (SETQ FACTS F)))))
03500 (GO A)
03600 ]
03700
03800 [DE LISTEN () (PROG2
03900
04000 (TERPRI) (TERPRI) (PRINC @"**")
04100 (SETQ STRING (READ))
04200 ]
04300
04400 [DF SAY: (L) (SETQ STRING L)]
04500
04600 [DE PS () (PROG2 (SETQ TREE NIL)
04700 (PARSE STRING @<S> @((NIL NIL)))
04800 (PRINTREE TREE)))
04900
05000 [DE I () (INTERPRET-S TREE)]
05100
05200 [DE PSI () (PROG2 (PS) (I))]
05300
05400 [SETQ TREE-TRACE NIL]
05500
05600 [SETQ TF-TRACE NIL]
05700
05800 [DE ATTR (NAME) (READLIST (CONS @% (EXPLODE NAME)))]
05900
00100 [DF P-RULES (L) (PROG (X Y Z)
00200
00300 A (COND ((NULL L) (RETURN NIL)))
00400 (SETQ X (REVERSE (CADR L)))
00500 (SETQ Y NIL)
00600 (SETQ Z NIL)
00700 B (COND ((NULL X)
00800 (SETQ Z (NCONC (LIST @! Y) Z))
00900 (PUTPROP (CAR L) Z @PRULE)
01000 (SETQ L (CDDR L))
01100 (GO A))
01200 ((EQ (CAR X) @!)
01300 (SETQ Z (CONS Y Z))
01400 (SETQ Y NIL))
01500 (T (SETQ Y (CONS (CAR X) Y))))
01600 (SETQ X (CDR X))
01700 (GO B)
01800 ]
01900
02000 [P-RULES
02100
02200 <S> (<SD> ! <SE> ! <SQ> ! <SEQ> ! <SWH> ! <SAQ> ! <SLQ>
02300 ! <SLEQ> ! <SCQ> ! <SCEQ>)
02400 <SD> (<NP> <VP>)
02500 <VP> (<COP> <PRED>)
02600 <COP> (%BE <NEG>)
02700 <PRED> (<PP> ! <ADJ>)
02800 <SE> (THERE <COP> <NP> <PP>)
02900 <SQ> (%BE <NP> <PRED>)
03000 <SEQ> (%BE THERE <NP> <PP>)
03100 <SWH> (WHAT <COP> <PRED>)
03200 <SAQ> (WHAT %ATTR %BE <NP>)
03300 <SLQ> (WHERE %BE <NP>)
03400 <SLEQ> (WHERE %BE THERE <NP>)
03500 <SCQ> (HOW MANY <NP1> <COP> <PRED>)
03600 <SCEQ> (HOW MANY <NP1> %BE THERE)
03700 <NEG> (NOT !)
03800 <PP> (%PREP <NP>)
03900 <NP> (%DET <NP1>)
04000 <NP1> (<MOD1> %NOUN <REL-CL>)
04100 <MOD1> (<ADJ> <MOD1> !)
04200 <ADJ> (%COLOR ! %SIZE)
04300 <REL-CL>(%WH <COP> <PRED> !)
04400 ]
04500
04600 (DEFPROP %BE (IS ARE) SET)
04700 (DEFPROP %PREP (IN ON UNDER NEAR) SET)
04800 (DEFPROP %DET (THE A) SET)
04900 (DEFPROP %SIZE (BIG SMALL) SET)
05000 (DEFPROP %COLOR (RED BLUE GREEN BLACK) SET)
05100 (DEFPROP %NOUN (BOX BALL BLOCK TABLE FLOOR) SET)
05200 (DEFPROP %WH (WHICH THAT) SET)
05300 (DEFPROP %ATTR (COLOR SIZE) SET)
05400
05500 [SETQ PLURALS @((BOXES . BOX)(BALLS . BALL)(BLOCKS . BLOCK)
05600 (TABLES . TABLE)(FLOORS . FLOOR))]
05700
05800 [DE SINGULARIZE (L) (PROG (X)
05900 (RETURN
06000 (COND ((SETQ X (ASSOC (CAR L) PLURALS))(RPLACA L (CDR X)))
06100 ((NULL L) NIL)
06200 (T (SINGULARIZE (CDR L)))))
06300 ]
06400
00100 [DE INTERPRET-S (TREE) (PROG (X SUBTREE QUES ATR ABORT)
00200
00300 (COND (TREE-TRACE (PRINTREE TREE)))
00400 (FINDNODE <S> TREE)
00500 (COND ((NOT (OR (T-SD) (T-SE)
00600 (SETQ QUES (OR (T-SEQ) (T-SQ) (T-SWH)
00700 (SETQ ATR (T-SAQ)) (T-SLQ) (T-SLEQ)(T-SCQ)(T-SCEQ)))))
00800 (ERROR1) (RETURN NIL))
00900 (ABORT (RETURN NIL)))
01000 NP (COND ((NULL (FINDNODE <NP> TREE)) NIL)
01100 ((INTERPRET-NP SUBTREE QUES) (GO NP))
01200 (T (RETURN NIL)))
01300 (FINDNODE SS TREE)
01400 (COND ((NULL SUBTREE) (GO S))
01500 ((NOT (OR (T-PRED-ADJ) (T-PRED-PP))) (ERROR1) (RETURN NIL))
01600 ((NOT (OR (T-NNEG) (T-NEG))) (ERROR1) (RETURN NIL)))
01700 S (FINDNODE <S> TREE)
01800 (SETQ X (CDAR SUBTREE))
01900 (COND ((EQ (CAR X) @FIND) (GO FIND))
02000 ((EQ (CAR X) @RECORD)
02100 (RECORD (CADR X))
02200 (SETQ REPLY @(OKAY)))
02300 ((EQ (CAR X) @VERIFY)
02400 (SETQ X (VERIFY (CADR X)))
02500 (SETQ REPLY (COND ((NULL X) @(I DONT KNOW)) ((EQ X @TRUE) @(YES)) (T @(NO)))))
02600 ((EQ (CAR X) @LOCATE) (GO LOCATE))
02700 ((EQ (CAR X) @COUNT) (GO COUNT))
02800 (T (ERROR1) (RETURN NIL)))
02900 (RETURN T)
03000 FIND (SETQ X (EVAL X))
03100 (SETQ REPLY (COND (ATR (COND ((NULL X) @(I DONT KNOW))
03200 (T X)))
03300 (T (DESCRIBE X))))
03400 (RETURN T)
03500 LOCATE (SETQ X (EVAL X))
03600 (SETQ REPLY (LOCATIONS X))
03700 (RETURN T)
03800 COUNT (COND ((FINDNODE AND TREE) (T-AND)))
03900 (SETQ X (EVAL X))
04000 (SETQ REPLY (LIST X))
04100 (RETURN T)
04200 ]
04300
04400 [DE INTERPRET-NP (TREE *ANY) (PROG (SUBTREE W X)
04500
04600 (COND ((EQ (CAR (CDADAR TREE)) @THE) (SETQ *ANY T)))
04700 (FINDNODE <NP1> TREE)
04800 (SETQ W (WORDS SUBTREE))
04900 (COND ((NULL (INTERPRET-NP1 SUBTREE *ANY))(RETURN NIL)))
05000 (SETQ SUBTREE TREE)
05100 (T-NP)
05200 (COND ((T-INDEF) (RETURN (COND ((NULL (CAR SUBTREE))
05300 (ERROR2) NIL)
05400 (T (CAR SUBTREE))))))
05500 (T-DEF)
05600 (SETQ X (CAR SUBTREE))
05700 (COND ((NULL X) (ERROR2))
05800 ((NULL (CDR X)) (RPLACA SUBTREE (CAR X)) (RETURN (CAR X)))
05900 (T (ERROR3)))
06000 ]
06100
06200 [DE INTERPRET-NP1 (TREE *ANY) (PROG (SUBTREE)
06300
06400 (SETQ SUBTREE TREE)
06500 (T-NP1)
06600 ADJ (COND ((T-ADJ) (GO ADJ)))
06700 (T-MOD1)
06800 BACK (COND ((T-NREL-CL) (GO ON))
06900 ((FINDNODE <NP> SUBTREE) (COND
07000 ((NULL (INTERPRET-NP SUBTREE *ANY)) (RETURN NIL))
07100 (T (GO BACK))))
07200 (T (FINDNODE <NP1> TREE)
07300 (COND ((NULL (T-REL-CL))(ERROR1)(RETURN NIL)))
07400 (FINDNODE SS SUBTREE)
07500 (COND ((NOT (OR (T-PRED-ADJ) (T-PRED-PP)))
07600 (ERROR1) (RETURN NIL))
07700 ((NOT (OR (T-NNEG) (T-NEG)))
07800 (ERROR1) (RETURN NIL)))))
07900 ON (FINDNODE AND TREE)
08000 AND (COND ((T-AND) (GO AND)))
08100 (RETURN T)
08200 ]
08300
08400 [DE ERROR1 () (SETQ REPLY @(I CANT INTERPRET YOUR SENTENCE))]
08500 [DE ERROR2 () (SETQ REPLY (APPEND @(THERE IS NO) W))]
08600 [DE ERROR3 () (SETQ REPLY (APPEND (APPEND @(I DONT KNOW WHICH) W) @(YOU MEAN)))]
08700
08800 [DF TF (L) (PROG2
08900
09000 (PUTPROP (CAR L) (CDR L) @TF)
09100 (PUTPROP (CAR L) (LIST @LAMBDA NIL (LIST @TFX (LIST @QUOTE (CAR L)))) @EXPR)
09200 ]
09300
09400 [TF T-SD
09500 (<S> (<SD> 1 (<VP> (<COP> 0 2) 3)))
09600 (<S> RECORD (SS 2 1 3))
09700 ]
09800 [TF T-SE
09900 (<S> (<SE> THERE (<COP> 0 1) 2 3))
10000 (<S> RECORD (SS 1 2 (<PRED> 3)))
10100 ]
10200 [TF T-SEQ
10300 (<S> (<SEQ> 0 THERE 1 2))
10400 (<S> VERIFY (SS (<NEG> NIL) 1 (<PRED> 2)))
10500 ]
10600 [TF T-SQ
10700 (<S> (<SQ> 0 1 2))
10800 (<S> VERIFY (SS (<NEG> NIL) 1 2))
10900 ]
11000 [TF T-SWH
11100 (<S> (<SWH> 0 (<COP> 0 1) 2))
11200 (<S> FIND 3 (SS 1 3 2))
11300 (SETV 3 (NEWNUM))
11400 ]
11500 [TF T-SAQ
11600 (<S> (<SAQ> WHAT (%ATTR 1) 0 2))
11700 (<S> FIND 3 (4 2 3))
11800 (SETV 4 (ATTR (QUOTE 1)))
11900 ]
12000 [TF T-SLQ
12100 (<S> (<SLQ> WHERE 0 1))
12200 (<S> LOCATE 1)
12300 ]
12400 [TF T-SLEQ
12500 (<S> (<SLEQ> WHERE 0 THERE 1))
12600 (<S> LOCATE 1)
12700 ]
12800 [TF T-SCQ
12900 (<S> (<SCQ> HOW MANY 1 (<COP> 0 2) 3))
13000 (<S> COUNT 4 (AND 5 (SS 2 4 3)))
13100 (PROG2 (COND ((NULL (INTERPRET-NP1 (FINDNODE <NP1> TREE) T))
13200 (SETQ ABORT T)))
13300 (SETV 4 (CADAR SUBTREE))
13400 (SETV 5 (CADDAR SUBTREE))
13500 (FINDNODE <S> TREE))
13600 ]
13700 [TF T-SCEQ
13800 (<S> (<SCEQ> HOW MANY 1 0 THERE))
13900 (<S> COUNT 2 3)
14000 (PROG2 (COND ((NULL (INTERPRET-NP1 (FINDNODE <NP1> TREE) T))
14100 (SETQ ABORT T)))
14200 (SETV 2 (CADAR SUBTREE))
14300 (SETV 3 (CADDAR SUBTREE))
14400 (FINDNODE <S> TREE))
14500 ]
14600 [TF T-PRED-ADJ
14700 (SS 1 2 (<PRED> (<ADJ> (3 4))))
14800 (SS 1 (3 2 4))
14900 ]
15000 [TF T-PRED-PP
15100 (SS 1 2 (<PRED> (<PP> (%PREP 3) 4)))
15200 (SS 1 (3 2 4))
15300 ]
15400 [TF T-NNEG
15500 (SS (<NEG> NIL) 1)
15600 1
15700 ]
15800 [TF T-NEG
15900 (SS (<NEG> NOT) 1)
16000 (NOT 1)
16100 ]
16200 [TF T-NP1
16300 (<NP1> 1 (%NOUN 2) 3)
16400 (<NP1> 4 1 3 (ISA 4 2))
16500 (SETV 4 (NEWNUM))
16600 ]
16700 [TF T-ADJ
16800 (<NP1> 1 (<MOD1> (<ADJ> (2 3)) 4) 5 6)
16900 (<NP1> 1 4 5 (AND 6 (2 1 3)))
17000 ]
17100 [TF T-MOD1
17200 (<NP1> 1 (<MOD1> NIL) 2 3)
17300 (<NP1> 1 2 3)
17400 ]
17500 [TF T-NREL-CL
17600 (<NP1> 1 (<REL-CL> NIL) 2)
17700 (<NP1> 1 2)
17800 ]
17900 [TF T-REL-CL
18000 (<NP1> 1 (<REL-CL> 0 (<COP> 0 2) 3) 4)
18100 (<NP1> 1 (AND 4 (SS 2 1 3)))
18200 ]
18300 [TF T-AND
18400 (AND (AND 1 2) . 3)
18500 (AND 1 2 . 3)
18600 ]
18700 [TF T-NP
18800 (<NP> (%DET 1) (<NP1> 2 3))
18900 (<NP> 1 2 3)
19000 ]
19100 [TF T-INDEF
19200 (<NP> A 1 2)
19300 3
19400 (PROG2 (SETV 3 (COND (*ANY (FIND 1 2))
19500 (T (CREATE 1 2)))) T)
19600 ]
19700 [TF T-DEF
19800 (<NP> THE 1 2)
19900 3
20000 (PROG2 (SETV 3 (FIND 1 2)) T)
20100 ]
20200
00100 [DE PRINTREE (TREE) (PROG2 (PRINTR (CAR TREE) (LIST NIL)) @*)]
00200
00300 [DE PRINTR (X M) (PROG ()
00400
00500 (COND ((NULL X) (PRINC @")") (RETURN NIL)))
00600 (TERPRI)
00700 (MAPC (FUNCTION (LAMBDA (Z) (PRINC @" "))) M)
00800 (COND ((ATOM X) (PRINC X) (RETURN NIL))
00900 ((AND (ATOM (CADR X)) (OR (NULL (CDDR X)) (AND
01000 (NULL (CDDDR X)) (ATOM (CADDR X))))) (PRINC X) (RETURN)))
01100 (PRINC @"(") (PRINC (CAR X))
01200 (SETQ M (CONS NIL M))
01300 (MAPC (FUNCTION (LAMBDA (Y) (PRINTR Y M))) (APPEND (CDR X) @(NIL)))
01400 ]
01500
01600 [DE WORDS (X) (PROG (W Z)
01700
01800 (SETQ Z (LIST NIL))
01900 (SETQ W Z)
02000 (WORD (CAR X))
02100 (RETURN (CDR Z))
02200 ]
02300
02400 [DE WORD (X) (COND
02500
02600 ((ATOM X) (COND ((NULL X) NIL)
02700 ((GET X @PRULE) NIL)
02800 ((GET X @SET) NIL)
02900 (T (RPLACD W (LIST X)) (SETQ W (CDR W)))))
03000 (T (WORD (CAR X)) (WORD (CDR X)))
03100 ]
03200
03300
03400 [DE SETV (N X) (SETQ V (CONS (CONS N X) V))]
03500
03600 [DE NEWNUM () (SETQ NEWNUM (ADD1 NEWNUM))]
03700
03800 (SETQ NEWNUM 100)
03900
04000 [DF FINDNODE (N) (PROG (%TREE Y)
04100
04200 (SETQ %TREE (EVAL (CADR N)))
04300 (SETQ N (CAR N))
04400 (COND ((EQ (CAAR %TREE) N) (RETURN (SETQ SUBTREE %TREE)))
04500 (T (RETURN (SETQ SUBTREE (FINDNODE1 (CAR %TREE))))))
04600 ]
04700
05700
05800
08100
08200 [SETQ FACTS NIL]
08300
08400 [SETQ FACT-TRACE NIL]
08500
08600 [DE RECORD (S) (COND
08700
08800 ((EQ (CAR S) @AND) (MAPC (FUNCTION RECORD) (CDR S)))
08900 (FACT-TRACE (TERPRI)
09000 (PRINC @"ADDING TO FACT LIST:")
09100 (PRINT S)
09200 (SETQ FACTS (CONS S FACTS))
09300 (TERPRI))
09400 (T (SETQ FACTS (CONS S FACTS)))
09500 ]
09600
09700 [DF CREATE (L) (PROG (X)
09800
09900 (SETQ X (GENSYM))
10000 (RECORD (SUBSTITUTE (LIST (CONS (CAR L) X)) (CADR L)))
10100 (RETURN X)
10200 ]
10300
10400 [DE VERIFY (S) (PROG (X)
10500
10600 (COND ((EQ (CAR S) @AND) (GO A))
10700 ((EQ (CAR S) @OR) (GO B))
10800 (T (RETURN (VERIFY1 S))))
10900 A (COND ((NULL (SETQ S (CDR S))) (RETURN @TRUE))
11000 ((NOT (EQ (SETQ X (VERIFY1 (CAR S))) @TRUE)) (RETURN X)))
11100 (GO A)
11200 B (COND ((NULL (SETQ S (CDR S))) (RETURN @FALSE))
11300 ((EQ (VERIFY1 (CAR S)) @TRUE) (RETURN @TRUE)))
11400 (GO B)
11500 ]
11600
11700 [DE VERIFY1 (S) (PROG (F N K Y1 Z1 PR L)
11800
11900 (SETQ F FACTS)
12000 (COND ((EQ (CAR S) @NOT) (SETQ N (SETQ K (CADR S)))
12100 (SETQ PR @NOT))
12200 (T (SETQ N (LIST @NOT S)) (SETQ K S)))
12300 (SETQ Y1 (CADR K))
12400 (SETQ Z1 (CADDR K))
12500 (COND ((AND (ATOM Y1)(ATOM Z1)) (GO A))
12600 ((ATOM Y1) (SETQ Y1 (LIST Y1)))
12700 ((ATOM Z1) (SETQ Z1 (LIST Z1))))
12800 (GO B)
12900 A (COND ((NULL F) (RETURN NIL))
13000 ((EQUAL (CAR F) S) (RETURN @TRUE))
13100 ((EQUAL (CAR F) N) (RETURN @FALSE)))
13200 (SETQ F (CDR F))
13300 (GO A)
13400 B (SETQ L (COMBINE (CAR K) Y1 Z1))
13500 (COND (PR (SETQ L (MAPCAR (FUNCTION (LAMBDA (X)
13600 (CONS PR (LIST X)))) L))))
13700 (RETURN (VERIFY (CONS @OR L)))
13800 ]
13900
14000 [DF FIND (L) (PROG (V X Z)
14100
14200 (SETQ V (CAR L))
14300 (SETQ L (CADR L))
14400 (SETQ L (COND ((EQ (CAR L) @AND) (CDR L))
14500 (T (LIST L))))
14600 (SETQ X (FIND1 V (CAR L)))
14700 (COND ((NULL (SETQ L (CDR L))) (RETURN X)))
14800 (SETQ L (CONS @AND L))
14900 A (COND ((NULL X) (RETURN Z))
15000 ((EQ (VERIFY (SUBSTITUTE (LIST (CONS V (CAR X))) L)) @TRUE)
15100 (SETQ Z (CONS (CAR X) Z))))
15200 (SETQ X (CDR X))
15300 (GO A)
15400 ]
15500
15600 [DE FIND1 (M S) (PROG (F X Z PR S1 S2)
15700
15800 (COND ((EQ (CAR S) @NOT) (SETQ PR @NOT)(SETQ S (CADR S)))
15900 ((NULL (CADDR S)) (RETURN NIL))
16000 ((ATOM (CADDR S)) (GO C)))
16100 (SETQ S1 (SUBST (CAADDR S) (CADDR S) S))
16200 (SETQ S2 (SUBST (CDADDR S) (CADDR S) S))
16300 (GO D)
16400 C (COND ((NULL (CADR S)) (RETURN NIL))
16500 ((ATOM (CADR S)) (GO B)))
16600 (SETQ S1 (SUBST (CAADR S)(CADR S) S))
16700 (SETQ S2 (SUBST (CDADR S)(CADR S) S))
16800 D (COND (PR (SETQ S1 (CONS PR (LIST S1)))
16900 (SETQ S2 (CONS PR (LIST S2)))))
17000 (RETURN (UNION (FIND1 M S1) (FIND1 M S2)))
17100 B (COND (PR (SETQ S (CONS PR (LIST S)))))
17200 (SETQ F FACTS)
17300 A (COND ((NULL F) (RETURN Z)))
17400 (SETQ X (MATCH NIL S (CAR F)))
17500 (SETQ X (ASSOC M X))
17600 (COND (X (SETQ Z (CONS (CDR X) Z))))
17700 (SETQ F (CDR F))
17800 (GO A)
17900 ]
18000
18100 [DE DESCRIBE (L) (PROG (Z)
18200
18300 (COND ((NULL L) (RETURN @(NOTHING))))
18400 (MAPC (FUNCTION DESCRIBE1) L)
18500 (RETURN (CDR Z))
18600 ]
18700
18800 [DE DESCRIBE1 (X) (PROG (Y)
18900
19000 (SETQ Y (FIND1 99 (LIST @ISA X 99)))
19100 (SETQ Y (NCONC (FIND1 99 (LIST @%COLOR X 99)) Y))
19200 (SETQ Y (NCONC (FIND1 99 (LIST @%SIZE X 99)) Y))
19300 (SETQ Z (NCONC Y Z))
19400 (SETQ Z (NCONC (LIST @AND @THE) Z))
19500 (RETURN (CDR Z))
19600 ]
19700
19800 [SETQ PREPS (GET @%PREP @SET)]
19900
20000 [DF LOCATE (X) (PROG (F Y Z)
20100
20200 (COND ((ATOM (CAR X))(SETQ X (LIST X))))
20300 (SETQ F FACTS)
20400 A (COND ((NULL F) (RETURN Z)))
20500 (SETQ Y (CAR F))
20600 (COND ((NOT (MEMQ (CAR Y) PREPS)) (GO B))
20700 ((MEMQ (CADR Y) (CAR X)) (SETQ Z (CONS Y Z))))
20800 B (SETQ F (CDR F))
20900 (GO A)
21000 ]
21100
21200 [DE LOCATIONS (L) (PROG (Z)
21300
21400 (COND ((NULL L) (RETURN @(I DONT KNOW))))
21500 (MAPC (FUNCTION LOC1) L)
21600 (RETURN (CDR Z))
21700 ]
21800
21900 [DE LOC1 (X) (PROG (Y)
22000
22100 (SETQ Y (DESCRIBE1 (CADDR X)))
22200 (SETQ Y (NCONC (LIST (CAR X)) Y))
22300 (SETQ Z (NCONC (LIST @AND) Y))
22400 ]
22500
22600 [DE COMBINE (SP L1 L2)
22700
22800 (COND ((NULL L2) NIL)
22900 (T (APPEND (COMBINE SP L1 (CDR L2))
23000 (COMBINE1 L1 (CAR L2)))))
23100 ]
23200
23300 [DE COMBINE1 (L X)
23400
23500 (COND ((NULL L) NIL)
23600 (T (CONS (LIST SP (CAR L) X) (COMBINE1 (CDR L) X))))
23700 ]
23800
23900 [DE UNION (U V)
24000
24100 (COND ((NULL U) V)
24200 ((MEMQ (CAR U) V) (UNION (CDR U) V))
24300 (T (CONS (CAR U) (UNION (CDR U) V))))
24400 ]
24500
24600 [SETQ NUMBERS @((0 . NONE)(1 . ONE)(2 . TWO)(3 . THREE)
24700 (4 . FOUR)]
24800
24900 [DF COUNT (L)
25000
25100 (COND ((*LESS (SETQ L (LENGTH(EVAL (CONS @FIND L)))) 5)
25200 (CDR (ASSOC L NUMBERS)))
25300 (T L))
25400 ]
25500
00100
00200 (SETQ *NOPOINT T)
00300 (RETURN @"MINI-LINGUISTIC SYSTEM READY") ]